perm filename MAPIII.SAI[GEO,BGB] blob
sn#016008 filedate 1972-12-10 generic text, type T, neo UTF8
00100 COMMENT ENTRY MAPMAK,MAPOUT,SCROLL;
00200 BEGIN "MAP"
00300 REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00400 REQUIRE "SAITRG[SYS,BGB]" SOURCE_FILE;
00500 REQUIRE "DPYIII[SYS,BGB]" SOURCE_FILE;
00600 PRELOAD_WITH
00700 .0000000 , .0000000 ,
00800 -22.99979 , .1983643@-3 ,
00900 -9.999536 , 24.00117 ,
01000 -35.00020 , 24.00084 ,
01100 -712.0187 , -443.3171 ,
01200 -691.9509 , -422.8889 ,
01300 -497.3859 , -520.2375 ,
01400 -488.6137 , -495.7614 ,
01500 -366.4894 , -154.9892 ,
01600 -190.9379 , -471.5671 ,
01700 -178.3295 , -494.3053 ,
01800 -245.2496 , -373.6192 ,
01900 -188.2198 , -277.2269 ,
02000 -360.5054 , 23.74415 ,
02100 -35.00002 , 349.0006 ,
02200 -22.99968 , 349.0002 ,
02300 326.0002 , .8583069@-4 ,
02400 68.04084 , -319.0442 ,
02500 -66.12744 , -400.6094 ,
02600 -81.03539 , -377.9573 ,
02700 -32.70698 , -334.5225 ,
02800 -34.62691 , -325.1313 ,
02900 -94.93315 , -315.5374 ,
03000 -112.9524 , -334.3569 ,
03100 -107.2662 , -368.7936 ,
03200 -81.03539 , -377.9573 ,
03300 -228.6772 , -198.7850 ,
03400 -225.2093 , -218.1996 ,
03500 -9.999530 , -299.9990 ,
03600 -.6103516@-4 , -300.0000 ,
03700 163.3915 , -251.6002 ,
03800 -143.3514 , -100.3745 ,
03900 -206.9260 , -179.8771 ,
04000 -248.7328 , -174.0623 ,
04100 -270.1300 , -169.1523 ,
04200 -296.0756 , -128.1069 ,
04300 -225.4402 , -90.54885 ,
04400 -262.5410 , -19.67216 ,
04500 -257.3356 , -19.28266 ,
04600 -235.1683 , 106.1126 ,
04700 -201.4372 , 113.5536 ,
04800 -248.2218 , 112.0019 ,
04900 -252.7818 , 103.1024 ,
05000 -262.0469 , 106.8675 ,
05100 -282.0767 , 22.83371 ,
05200 -292.0447 , 23.64030 ,
05300 -302.0428 , 23.43554 ,
05400 -321.9830 , 19.57827 ,
05500 -327.9778 , -59.97264 ,
05600 -332.1181 , -57.17142 ,
05700 -337.1169 , -57.01620 ,
05800 -347.0000 , 24.00042 ,
05900 -339.4767 , 92.10479 ,
06000 -335.0025 , 88.10585 ,
06100 -329.3224 , 89.21445 ,
06200 -309.3915 , 92.43884 ,
06300 -298.3050 , 165.6742 ,
06400 -276.2897 , 153.8287 ,
06500 -277.0167 , 178.8179 ,
06600 -234.6786 , 184.5172 ,
06700 -196.5484 , 194.2015 ,
06800 -179.5380 , 210.4702 ,
06900 -169.1679 , 198.4892 ,
07000 -157.2133 , 207.5492 ,
07100 -134.5305 , 220.1497 ,
07200 -141.8876 , 232.1902 ,
07300 -124.8248 , 242.6234 ,
07400 -142.9540 , 251.0708 ,
07500 -139.0740 , 259.3903 ,
07600 -149.9487 , 264.4620 ,
07700 -177.9614 , 227.5139 ,
07800 -205.7761 , 203.2610 ,
07900 -229.5678 , 244.2995 ,
08000 -237.8086 , 197.1925 ,
08100 -257.6296 , 194.5243 ,
08200 -251.3819 , 208.1616 ,
08300 -264.0584 , 216.1807 ,
08400 -34.99987 , 323.0004 ,
08500 -22.99999 , 323.0008 ,
08600 300.0008 , .3929138@-3 ,
08700 299.6896 , -15.56232 ,
08800 284.7106 , -14.78171 ,
08900 283.4387 , -29.78943 ,
09000 174.0408 , -18.29135 ,
09100 117.4829 , -550.9601 ,
09200 -249.6434 , 310.9497 ,
09300 -781.9525 , 14.23944 ,
09400 -707.9570 , 15.09746 ,
09500 -93.11935 , -368.4996 ,
09600 -98.57252 , -330.0892 ,
09700 -34.97943 , -330.1192 ,
09800 -257.1021 , -161.7186 ,
09900 -215.8161 , -206.5051 ,
10000 -155.7823 , 205.6606 ;
10100 REAL ARRAY LOCII[0:93,1:2];
10200 PRELOAD_WITH
10300 4, 5,
10400 5, 7,
10500 4, 6,
10600 28, 29,
10700 77, 78,
10800 14, 15,
10900 58, 59,
11000 60, 61,
11100 64, 93,
11200 63, 93,
11300 64, 65,
11400 68, 69,
11500 70, 71,
11600 73, 74,
11700 39, 41,
11800 37, 38,
11900 31, 33,
12000 26, 32,
12100 82, 83,
12200 34, 35,
12300 79, 80,
12400 67, 68;
12500 INTEGER ARRAY SEGS[1:22,1:2];
12600 PRELOAD_WITH
12700 7, 9, 8,
12800 6, 10, 8,
12900 9, 12, 11,
13000 10, 18, 8,
13100 19, 20, 84,
13200 20, 21, 90,
13300 21, 22, 2,
13400 22, 23, 89,
13500 23, 24, 11,
13600 24, 25, 88,
13700 27, 28, 2,
13800 29, 30, 0,
13900 17, 18, 84,
14000 12, 13, 2,
14100 80, 82, 81,
14200 33, 34, 91,
14300 26, 27, 92,
14400 16, 17, 0,
14500 78, 79, 1,
14600 15, 16, 1,
14700 76, 77, 3,
14800 65, 67, 66,
14900 61, 63, 62,
15000 69, 70, 85,
15100 71, 73, 72,
15200 59, 60, 72,
15300 56, 58, 57,
15400 74, 76, 75,
15500 55, 56, 40,
15600 13, 14, 3,
15700 46, 55, 87,
15800 44, 46, 45,
15900 43, 44, 0,
16000 41, 43, 42,
16100 38, 39, 0,
16200 35, 37, 36,
16300 48, 50, 49,
16400 48, 47, 86,
16500 47, 54, 87,
16600 52, 54, 53,
16700 51, 52, 3,
16800 50, 51, 2;
16900 INTEGER ARRAY ARCS[1:42,1:3];
00010 DEFINE DMS(D,M,S)="(π*((S/60+M)/60+D)/180)";
00100 SAFE ITG ARRAY DPYBUF[1:2500];
00200 REAL XL,XH,YL,YH;
00300
00400 EXTERNAL BOOLEAN PROCEDURE CLIP (REFERENCE REAL X1,Y1,X2,Y2);
00500 EXTERNAL PROCEDURE CLIPIN (REAL XL,XH,YL,YH);
00600
00700 REAL BEAMX,BEAMY,MAGX,MAGY,SOX,SOY;
00800 SUBR AI(REAL X,Y);
00900 ⊂ BEAMX←X*MAGX+SOX;
01000 BEAMY←Y*MAGY+SOY;⊃;
01100 SUBR AV(REAL X,Y);
01200 BEGIN
01300 REAL X1,Y1,X2,Y2;
01400 X1←BEAMX;
01500 Y1←BEAMY;
01600 X2←BEAMX←X*MAGX+SOX;
01700 Y2←BEAMY←Y*MAGY+SOY;
01800 IF CLIP(X1,Y1,X2,Y2)∧(ABS(X1-X2)≥1 ∨ ABS(Y1-Y2)≥1) THEN
01900 ⊂ AIVECT(X1,Y1);AVECT(X2,Y2);⊃;
02000 END;
00100 SUBR ARC(REAL R,B,A);
00200 BEGIN
00300 REAL BXSAV,BYSAV; ITG RMAGX;
00400 REAL XX,X,Y,C,S,CX,CY,D; ITG M,N,I;
00500 BXSAV←BEAMX; BYSAV←BEAMY;
00600
00700 α CENTER OF THE CIRCLE;
00800 CX ← (BEAMX-SOX)/MAGX;
00900 CY ← (BEAMY-SOY)/MAGY;
00975 RMAGX ← ABS(R*MAGX); IF RMAGX≤1 THEN RETURN;
01000 α START OF ARC;
01100 X ← COS(A)*R;
01200 Y ← SIN(A)*R;
01300 AI(CX+X,CY+Y);
01350
01400 α NUMBER OF STEPS DEPENDS ON CURVATURE AND ARC LENGTH;
01500 M ← IF RMAGX≤4 THEN 1 ELSE
01600 IF RMAGX≤100 THEN 9 ELSE
01700 IF RMAGX≤400 THEN 12 ELSE 15;
01800 N ← ABS(M*B/π) MAX 1;
01900 α DELTA RADIANS PER STEP;
02000 D ← B/N;
02100 C ← COS(D);
02200 S ← SIN(D);
02300 α WILL THE CIRCLE BE UNBROKEN;
02400 FOR I←1 TO N DO
02500 BEGIN
02600 XX ← C*X - S*Y;
02700 Y ← C*Y + S*X; X←XX;
02800 AV(CX+X,CY+Y);
02900 END;
03000 BEAMX ← BXSAV; BEAMY ← BYSAV;
03100 END;
00100 SUBR RADIAL (REAL R1,R2,W);
00200 BEGIN "RADIAL"
00300 REAL BXSAV,BYSAV;
00400 REAL C,S,CX,CY;
00500 BXSAV ← BEAMX; BYSAV ← BEAMY;
00600 C ← COS(W);
00700 S ← SIN(W);
00800 CX ← (BEAMX-SOX)/MAGX; CY ← (BEAMY-SOY)/MAGY;
00850 IF R1≠R2 ∧ ABS(R2-R1)≤4 THEN RETURN;
00900 AI(CX+C*R1,CY+S*R1); IF R1=R2 THEN RETURN;
01000 AV(CX+C*R2,CY+S*R2);
01100 BEAMX ← BXSAV; BEAMY ← BYSAV;
01200 END "RADIAL";
00100 α WINDOWS;
00200 PRELOAD_WITH 0,0,511,511; SHORT INTEGER ARRAY DWN[1:4];
00300 PRELOAD_WITH 0,0,1300,1300; SHORT REAL ARRAY LWN[1:4];
00400 α PROPERTY LINE;
00500 PRELOAD_WITH
00600 -745,-465, 130,-900, 360,-710,
00700 1170,140, 290,780, 100,870,
00800 -510,470, -510,360, -540,210,
00900 -595,50, -625,-30, -690,-305,
01000 -705,-360, -745,-465;
01100 INTEGER ARRAY PLINE[0:13,1:2];
01200 INTEGER I,GRID,MODE,GRIDSF;
01300
01400 INTERNAL PROCEDURE MAPMAK;
01500 BEGIN "MAPMAK"
01600 DPYSET(DPYBUF);
01700 MAGX ← DWN[3]/LWN[3]; SOX ← -LWN[1]*MAGX;
01800 MAGY ← DWN[4]/LWN[4]; SOY ← -LWN[2]*MAGY;
01900 XL ← DWN[1]-DWN[3]; YL ← DWN[2]-DWN[4];
02000 XH ← DWN[1]+DWN[3]; YH ← DWN[2]+DWN[4];
02100 CLIPIN(XL,XH,YL,YH);
02200 AIVECT(XL,YL);
02300 AVECT(XH,YL);
02400 AVECT(XH,YH);
02500 AVECT(XL,YH);
02600 AVECT(XL,YL);
00100 IF MODE THEN
00200 BEGIN
00300 α DISPLAY PROPERTY LINE;
00400 AI(PLINE[0,1],PLINE[0,2]);
00500 FOR I←1 TO 13 DO
00600 AV(PLINE[I,1],PLINE[I,2]);
00700
00800 α OUTLINE OF THE BUILDING;
00900 AI(0,0);
01000 ARC(138,6*π/7,π/5);
01100 ARC(258,6*π/7,π/5);
01200 RADIAL(138,258,π/5);
01300 RADIAL(138,258,37*π/35);
01400 END;
01600 IF (MODE LAND 1) THEN
01700 BEGIN "ROAD CENTER"
01800 α DISPLAY THE ENTRY ROAD;
01900 AI(-730.29,-422.96);
02000 AV(-493.00,-508.00);
02100 AI(-366.5,-154.99);
02200 ARC(375,DMS(48,43,34),-DMS(109,43,00));
02300 ARC(375,DMS(21,42,55),-DMS(60,59,25));
02400 AI(117.32,-550.64);
02500 ARC(250,DMS(38,41,44),DMS(102,01,45));
02600 AI(-245.25,-373.62);
02700 ARC(125,DMS(120,22,49),-DMS(60,59,25));
02800 α DISPLAY THE CIRCULAR ROAD;
02900 AI(-35,24);ARC(312,π/2,π/2);
03000 AI(-10,24);ARC(337,π/2,π);
03100 AI(-23,0); ARC(336,π/2,0);
03200 AI(0,0);ARC(313,-π/2,0);
03300 AI(-10,-313);AV(0,-313);
03400 AI(-35,336);AV(-23,336);
03500 α DISPLAY THE PARKING LOT LANES;
03600 AI(0,0);
03700 RADIAL(186,313,-DMS(9,00,00));
03800 RADIAL(186,313,-DMS(51,00,00));
03900 RADIAL(186,255,π+DMS(84,40,00));
04000 RADIAL(186,329.17,π+DMS(38,00,00));
04100 ARC(186,-DMS(133,00,00),-DMS(9,00,00));
04200 ARC(255,-DMS(133,00,00),-DMS(9,00,00));
04300 END "ROAD CENTER";
00100 IF MODE LAND 2 THEN
00200 BEGIN "LAMP ISLANDS"
00300 REAL ARRAY QQ[1:6];
00400 REAL DEL,INNER,OUTER,SIGN;
00500 INTEGER I;
00600 QQ[1] ← -DMS(12,50,00);
00700 QQ[2] ← -DMS(47,10,00);
00800 QQ[3] ← -DMS(54,50,00);
00900 QQ[4] ← π + DMS(88,30,00);
01000 QQ[5] ← π + DMS(80,50,00);
01100 QQ[6] ← π + DMS(41,50,00);
01200 DEL ← DMS(0,50,00);
01300 INNER ← DMS(175,20,00);
01400 OUTER ← DMS(181,40,00);
01500 FOR I←1 TO 6 DO
01600 BEGIN
01700 AI(0,0);
01800 RADIAL(201.82,239.46,QQ[I]-DEL);
01900 RADIAL(201.82,239.46,QQ[I]+DEL);
02000 RADIAL(201.94,201.94,QQ[I]);
02100 ARC(2.94,INNER,QQ[I]+π-INNER/2);
02200 AI(0,0);
02300 RADIAL(239.51,239.51,QQ[I]);
02400 ARC(3.49,-OUTER,QQ[I]+OUTER/2);
02500 END;
02600 QQ[1] ← -DMS(13,30,00);
02700 QQ[2] ← -DMS(46,30,00);
02800 QQ[3] ← -DMS(55,30,00);
02900 QQ[4] ← π + DMS(42,30,00);
03000 INNER ← DMS(177,00,00);
03100 OUTER ← DMS(87,00,00);
03200 DEL ← DMS(1,30,00);
03300 FOR I←1 TO 4 DO
03400 BEGIN
03500 AI(0,0);RADIAL(274.18,274.18,QQ[I]);
03600 ARC(7.18,INNER,QQ[I]+DEL+π/2);
03700 SIGN ← (IF I LAND 1 THEN 1 ELSE -1);
03800 AI(0,0);
03900 RADIAL(274,289.0 ,QQ[I]-SIGN*DEL);
04000 IF I=4 THEN DONE;
04100 RADIAL(274,285.786,QQ[I]+SIGN*DEL);
04200 RADIAL(285,285,QQ[I]-SIGN*DEL);
04300 ARC(15,SIGN*OUTER,QQ[I]-SIGN*DEL);
04400 END;
04500 AI(0,0);
04600 ARC(175,-DMS(139,00,00),-DMS(6,00,00));
04700 ARC(289,-π/6,-π/12);
04800 ARC(300,-π/6,-π/12);
04900 ARC(289,DMS(79,00,00),π+DMS(44,00,00));
05000
05100 END "LAMP ISLANDS";
00100 α DISPLAY GRID LINES;
00200 IF ¬GRIDSF THEN
00300 BEGIN "GRID"
00400 REAL Q,X,Y,XL,XH,YL,YH;
00500 INTEGER I;
00600 Q ← LWN[3]/4;
00700 GRID ← IF Q < 1 THEN 1 ELSE
00800 IF Q < 5 THEN 5 ELSE
00900 IF Q < 10 THEN 10 ELSE
01000 IF Q < 25 THEN 25 ELSE
01100 IF Q < 50 THEN 50 ELSE
01200 IF Q < 100 THEN 100 ELSE
01300 IF Q < 200 THEN 200 ELSE
01400 IF Q < 500 THEN 500 ELSE
01500 IF Q < 1000 THEN 1000 ELSE
01600 IF Q < 2000 THEN 2000 ELSE
01700 IF Q < 5280 THEN 5280 ELSE 10560;
01800 AI(LWN[1],LWN[2]+5);AV(LWN[1],LWN[2]-5);
01900 AI(LWN[1]-5,LWN[2]);AV(LWN[1]+5,LWN[2]);
02000 α COMPUTE THE GRID WINDOW SO THAT IT LIES ON ABSOLUTE GRID MULTIPLES;
02100 I ← LWN[1]/GRID;
02200 XL ← (I-3)*GRID;
02300 XH ← XL + 6*GRID;
02400 I ← LWN[2]/GRID;
02500 YL ← (I-3)*GRID;
02600 YH ← YL + 6*GRID;
02700 α VERTICALS;
02800 X ← XL;
02900 FOR I←-3 TO 3 DO
03000 BEGIN
03100 AI(X,YL);
03200 AV(X,YH);
03300 X ← X + GRID;
03400 END;
03500
03600 α HORIZONTALS;
03700 Y ← YL;
03800 FOR I←-3 TO 3 DO
03900 BEGIN
04000 AI(XL,Y);
04100 AV(XH,Y);
04200 Y ← Y + GRID;
04300 END;
04400 END "GRID";
04500
00100 IF MODE LAND 2 THEN
00200 BEGIN "PAVEMENT"
00300 INTEGER I;
00400 α SEGMENTS;
00500 FOR I←1 TO 22 DO
00600 BEGIN
00700 INTEGER P1,P2;
00800 P1 ← SEGS[I,1];
00900 P2 ← SEGS[I,2];
01000 AI(LOCII[P1,1],LOCII[P1,2]);
01100 AV(LOCII[P2,1],LOCII[P2,2]);
01200 END;
01300
01400 α ARCS;
01500 FOR I←1 TO 42 DO
01600 BEGIN
01700 REAL X,Y,X1,Y1,X2,Y2;
01800 REAL RR,R,A,B;
01900 INTEGER P1,P2,P3;
02000 P1 ← ARCS[I,1];
02100 P2 ← ARCS[I,2];
02200 P3 ← ARCS[I,3];
02300 X ← LOCII[P3,1];
02400 Y ← LOCII[P3,2];
02500 X1 ← LOCII[P1,1]-X;
02600 Y1 ← LOCII[P1,2]-Y;
02700 X2 ← LOCII[P2,1]-X;
02800 Y2 ← LOCII[P2,2]-Y;
02900 RR ← X1↑2 + Y1↑2;
03000 R ← SQRT(RR);
03100 A ← ACOS((X1*X2+Y1*Y2)/RR);
03200 B ← ATAN2(Y1,X1);
03300 A ← (IF X1*Y2 < X2*Y1 THEN -A ELSE A);
03400 AI(X,Y);
03500 ARC(R,A,B);
03600 END;
03700 END "PAVEMENT";
03800 END "MAPMAK";
03900
00100 INTERNAL PROCEDURE MAPOUT;
00200 BEGIN "MAPOUT"
00400 IF ¬GRIDSF THEN BEGIN
00500 AIVECT(-100,-400);
00550 IF GRID<5280 THEN DPYSST(CVS(GRID)&" FOOT GRID") ELSE
00575 DPYSST(CVS(GRID%5280)&" MILE GRID");
00600 AIVECT(0,0);DPYSST(CVS(LWN[1])&","&CVS(LWN[2]));END;
00610 DPYOUT(10);
00700 END "MAPOUT";
00100 INTERNAL PROCEDURE SCROLL;
00200 BEGIN "SCROLL"
00300 LABEL L1,L2;
00400 DEFINE X="LWN[1]";
00500 DEFINE Y="LWN[2]";
00600 DEFINE DX="LWN[3]";
00700 DEFINE DY="LWN[4]";
00800 INTEGER CHR,DELPOW;
00900 MODE ← 1;
01000 MAPMAK;
01100 MAPOUT;
01200 L1: CHR ← INCHRW;
01300 IF CHR='175 THEN BEGIN OUTSTR(↓&"*");RETURN;END;
01400 IF CHR=13 THEN OUTCHR(".") ELSE
01500 IF CHR="\" THEN DELPOW←(DELPOW-1)MAX 0 ELSE
01600 IF CHR="/" THEN DELPOW← DELPOW+1 ELSE GO L2;GO L1;
01700 DEFINE DELTAX="DX/(1 LSH DELPOW)";
01800 DEFINE DELTAY="DY/(1 LSH DELPOW)";
01900 L2: IF CHR=":" THEN X←X + DELTAX ELSE
02000 IF CHR=";" THEN X←X - DELTAX ELSE
02100 IF CHR="(" THEN Y←Y - DELTAY ELSE
02200 IF CHR=")" THEN Y←Y + DELTAY ELSE
02300 IF CHR="-" THEN BEGIN DX←DX/2;DY←DY/2;END ELSE
02400 IF CHR="*" THEN BEGIN DX←DX*2;DY←DY*2;END ELSE
02500 IF CHR="," THEN GRIDSF←¬GRIDSF ELSE
02600 IF CHR="." THEN MODE←(MODE+1)LAND 3 ELSE GO L1;
02700 MAPMAK;MAPOUT;
02800 GO L1;
02900 END "SCROLL";
03000 WHILE TRUE DO SCROLL;
03100
03200 END "MAP";